***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
*** This Program already converted to Y2K                                                                                                                                                                                                                 
*** S&T Departement     on 29 April 1999 by Ben.Rahman                                                                                                                                                                                                    
***                                                                                                                                                                                                                                                       
***                                                                                                                                                                                                                                                       
set cent on                                                                                                                                                                                                                                               
*  FILE NAME: INVADJUS.PRG                                                                                                                                                                                                                                
*  BY: NURJADI PURNAMA                                                                                                                                                                                                                                    
*  DATE: January 25, 1993                                                                                                                                                                                                                                 
*  DESC:                                                                                                                                                                                                                                                  
*  CALLED BY:                                                                                                                                                                                                                                             
*  DATA FILES:                                                                                                                                                                                                                                            
                                                                                                                                                                                                                                                          
set proc to sospro                                                                                                                                                                                                                                        
SET PROC TO BOXPROC                                                                                                                                                                                                                                       
set proc to ADDREPRO                                                                                                                                                                                                                                      
STORE ' ' TO AEANAME,AEAADDR,AEACITY,AEACOUN,AEACURR                                                                                                                                                                                                      
STORE .F. TO AEAHEAL,AEADECI                                                                                                                                                                                                                              
do start                                                                                                                                                                                                                                                  
DR='n:'                                                                                                                                                                                                                                                   
*REST FROM n:STNAME ADDI                                                                                                                                                                                                                                  
*PUBLIC SITENAME,SITELOCA                                                                                                                                                                                                                                 
tgl=date()-1                                                                                                                                                                                                                                              
do while .t.                                                                                                                                                                                                                                              
   @ 12, 27 SAY 'Transaction Date : ' get tgl pict '99/99/9999'                                                                                                                                                                                           
   read                                                                                                                                                                                                                                                   
   if tgl>=date()                                                                                                                                                                                                                                         
      loop                                                                                                                                                                                                                                                
   endif                                                                                                                                                                                                                                                  
   exit                                                                                                                                                                                                                                                   
enddo                                                                                                                                                                                                                                                     
                                                                                                                                                                                                                                                          
IF MONTH(DATE())<>MONTH(TGL)                                                                                                                                                                                                                              
   dr1='N:'                                                                                                                                                                                                                                               
   DR='Q:'                                                                                                                                                                                                                                                
   F1='PATIENT'                                                                                                                                                                                                                                           
   F2='ACTIVIT2'                                                                                                                                                                                                                                          
   F3='REVENUE2'                                                                                                                                                                                                                                          
   F33='REVNBER'                                                                                                                                                                                                                                          
   F4='ACT_PRO2'                                                                                                                                                                                                                                          
   F41='ACT_RPAT'                                                                                                                                                                                                                                         
   F5='ACT_PHA2'                                                                                                                                                                                                                                          
   F51='ACT_HPAT'                                                                                                                                                                                                                                         
   F6='DOCT_FE2'                                                                                                                                                                                                                                          
ELSE                                                                                                                                                                                                                                                      
   dr1='N:'                                                                                                                                                                                                                                               
   DR='N:'                                                                                                                                                                                                                                                
   F1='PATIENT'                                                                                                                                                                                                                                           
   F2='ACTIVIT1'                                                                                                                                                                                                                                          
   F3='REVENUE1'                                                                                                                                                                                                                                          
   F33='REVNBER'                                                                                                                                                                                                                                          
   F4='ACT_PRO1'                                                                                                                                                                                                                                          
   F41='ACT_RPAT'                                                                                                                                                                                                                                         
   F5='ACT_PHA1'                                                                                                                                                                                                                                          
   F51='ACT_HPAT'                                                                                                                                                                                                                                         
   F6='DOCT_FE1'                                                                                                                                                                                                                                          
ENDIF                                                                                                                                                                                                                                                     
                                                                                                                                                                                                                                                          
SELE 2                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F2                                                                                                                                                                                                                                                
IF NET_USE("&DR&F2",.T.,'2',10)                                                                                                                                                                                                                           
   INDE ON INV_NBER TO &DR&F2                                                                                                                                                                                                                             
ENDIF                                                                                                                                                                                                                                                     
USE                                                                                                                                                                                                                                                       
                                                                                                                                                                                                                                                          
SELE 3                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F3                                                                                                                                                                                                                                                
IF NET_USE("&DR&F3",.T.,'3',10)                                                                                                                                                                                                                           
   INDE ON INV_NBER TO &DR&F33                                                                                                                                                                                                                            
ENDIF                                                                                                                                                                                                                                                     
USE                                                                                                                                                                                                                                                       
                                                                                                                                                                                                                                                          
SELE 4                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F4                                                                                                                                                                                                                                                
IF NET_USE("&DR&F4",.T.,'4',10)                                                                                                                                                                                                                           
   INDE ON INV_NBER TO &DR&F41                                                                                                                                                                                                                            
ENDIF                                                                                                                                                                                                                                                     
USE                                                                                                                                                                                                                                                       
                                                                                                                                                                                                                                                          
SELE 5                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F5                                                                                                                                                                                                                                                
IF NET_USE("&DR&F5",.T.,'5',10)                                                                                                                                                                                                                           
   INDE ON INV_NBER TO &DR&F51                                                                                                                                                                                                                            
ENDIF                                                                                                                                                                                                                                                     
USE                                                                                                                                                                                                                                                       
                                                                                                                                                                                                                                                          
SELE 6                                                                                                                                                                                                                                                    
SET EXCLU OFF                                                                                                                                                                                                                                             
USE &DR&F6                                                                                                                                                                                                                                                
IF NET_USE("&DR&F6",.T.,'6',10)                                                                                                                                                                                                                           
   INDE ON INV_NBER TO &DR&F6                                                                                                                                                                                                                             
ENDIF                                                                                                                                                                                                                                                     
USE                                                                                                                                                                                                                                                       
PL1=0                                                                                                                                                                                                                                                     
DO WHILE .T.                                                                                                                                                                                                                                              
   SET COLO TO BG+/B                                                                                                                                                                                                                                      
   CLEAR                                                                                                                                                                                                                                                  
*   DO HDCOMP                                                                                                                                                                                                                                             
   DO ADDRESSS                                                                                                                                                                                                                                            
   DO ADDRADJU                                                                                                                                                                                                                                            
   SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                                 
   @  9, 3 TO 17,68 DOUBLE                                                                                                                                                                                                                                
   @ 10, 5 PROMPT "A .. VOID THIS INVOICE                                       "                                                                                                                                                                         
   @ 12, 5 prompt "B .. CHANGE INVOICE TO CASH PAYMENT                          "                                                                                                                                                                         
   @ 14, 5 PROMPT "C .. CHANGE INVOICE TO CREDIT PAYMENT                        "                                                                                                                                                                         
   @ 16, 5 PROMPT "X .. EXIT PROGRAMME                          "                                                                                                                                                                                         
   MENU TO PL1                                                                                                                                                                                                                                            
   IF LAST()=27                                                                                                                                                                                                                                           
      CLEAR                                                                                                                                                                                                                                               
      RETURN                                                                                                                                                                                                                                              
   ENDIF                                                                                                                                                                                                                                                  
   DO CASE                                                                                                                                                                                                                                                
   CASE PL1=1                                                                                                                                                                                                                                             
      KTR='VOID THIS INVOICE'                                                                                                                                                                                                                             
   CASE PL1=2                                                                                                                                                                                                                                             
      KTR='CHANGE INVOICE TO CASH PAYMENT'                                                                                                                                                                                                                
   CASE PL1=3                                                                                                                                                                                                                                             
      KTR='CHANGE INVOICE TO CREDIT PAYMENT'                                                                                                                                                                                                              
   CASE PL1=4                                                                                                                                                                                                                                             
      RETURN                                                                                                                                                                                                                                              
   ENDCASE                                                                                                                                                                                                                                                
   SET COLO TO BG+*/B,W+/N                                                                                                                                                                                                                                
   @ 8,40-LEN(KTR)/2 SAY KTR                                                                                                                                                                                                                              
   SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                                 
   @  9, 3 CLEAR TO 23,68                                                                                                                                                                                                                                 
   PATCOD=SPACE(6)                                                                                                                                                                                                                                        
   @ 10,7 SAY 'PATIENT CODE    :' GET PATCOD                                                                                                                                                                                                              
   READ                                                                                                                                                                                                                                                   
   SELE 1                                                                                                                                                                                                                                                 
   SET EXCLU OFF                                                                                                                                                                                                                                          
   USE &DR1&F1 INDE &DR1&F1                                                                                                                                                                                                                               
   SEEK PATCOD                                                                                                                                                                                                                                            
   IF EOF()                                                                                                                                                                                                                                               
      CLOSE ALL                                                                                                                                                                                                                                           
      LOOP                                                                                                                                                                                                                                                
   ENDIF                                                                                                                                                                                                                                                  
   SET COLO TO GR+/B,W+/N                                                                                                                                                                                                                                 
   IF HEALTHLINE                                                                                                                                                                                                                                          
      @ 10,33 SAY 'HEALTHLINE'                                                                                                                                                                                                                            
   ELSE                                                                                                                                                                                                                                                   
      SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                              
      @ 10,33 SAY '          '                                                                                                                                                                                                                            
   ENDIF                                                                                                                                                                                                                                                  
   SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                                 
   @ 10,45 SAY 'PATIENT NAME    : '+ ALLTRIM(PAT_NAME)+' '+ALLTRIM(PAT_F_NAME)                                                                                                                                                                            
   INVOI=SPACE(5)                                                                                                                                                                                                                                         
   @ 12,7 SAY 'INVOICE NO.     : ' GET INVOI                                                                                                                                                                                                              
   READ                                                                                                                                                                                                                                                   
   SELE 3                                                                                                                                                                                                                                                 
                                                                                                                                                                                                                                                          
   SET EXCLU OFF                                                                                                                                                                                                                                          
   USE &DR&F3 INDE &DR&F33                                                                                                                                                                                                                                
   SEEK INVOI                                                                                                                                                                                                                                             
   IF EOF()                                                                                                                                                                                                                                               
      CLOSE ALL                                                                                                                                                                                                                                           
      LOOP                                                                                                                                                                                                                                                
   ENDIF                                                                                                                                                                                                                                                  
   ACTCOD=PAT_FILCOD                                                                                                                                                                                                                                      
   IF PATCOD<>ACTCOD                                                                                                                                                                                                                                      
      SET COLO TO BG+*/B,W+/N                                                                                                                                                                                                                             
      @ 20,7 SAY 'PATIENT IDENTITY IS DIFFERENT'                                                                                                                                                                                                          
      WAIT ''                                                                                                                                                                                                                                             
      SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                              
      @ 20,7 CLEAR TO 20,77                                                                                                                                                                                                                               
      CLOSE ALL                                                                                                                                                                                                                                           
      LOOP                                                                                                                                                                                                                                                
   ENDIF                                                                                                                                                                                                                                                  
   @ 12,45 SAY 'DATE OF INVOICE : '+DTOC(DATE_VISIT)                                                                                                                                                                                                      
   @ 14,7 SAY 'PAYMENT MODE    : '+PAY_MODE                                                                                                                                                                                                               
   @ 14,45 SAY 'INVOICE AMOUNT  : '+TRANS(TOTAL_FEE,'##,###,###')                                                                                                                                                                                         
   @ 16,7 SAY 'CASH PAYMENT    : '+TRANS(TOTAL_CASH,'##,###,###')                                                                                                                                                                                         
   @ 16,45 SAY 'CREDIT VOUCHER  : '+TRANS(TOTAL_CRED,'##,###,###')                                                                                                                                                                                        
   @ 18,7 SAY 'HEALTHLINE      : '+TRANS(TOTAL_HL,'##,###,###')                                                                                                                                                                                           
   TCAS=TOTAL_CASH                                                                                                                                                                                                                                        
   TCRE=TOTAL_CRED                                                                                                                                                                                                                                        
   @ 20, 45 SAY 'CONFIRM : Yes / No'                                                                                                                                                                                                                      
   @ 20,55 PROMPT 'Yes'                                                                                                                                                                                                                                   
   @ 20,61 PROMPT 'No'                                                                                                                                                                                                                                    
   MENU TO PIL1                                                                                                                                                                                                                                           
   IF PIL1=2                                                                                                                                                                                                                                              
      CLOSE ALL                                                                                                                                                                                                                                           
      LOOP                                                                                                                                                                                                                                                
   ENDIF                                                                                                                                                                                                                                                  
   DO CASE                                                                                                                                                                                                                                                
   CASE PL1=1                                                                                                                                                                                                                                             
      TPRIC  = 0                                                                                                                                                                                                                                          
      THPRIC = 0                                                                                                                                                                                                                                          
      TPPRIC = 0                                                                                                                                                                                                                                          
      SELE 4                                                                                                                                                                                                                                              
      SET EXCLU OFF                                                                                                                                                                                                                                       
      USE &DR&F4 INDE &DR&F41                                                                                                                                                                                                                             
      SEEK INVOI                                                                                                                                                                                                                                          
      DO WHILE INVOI=INV_NBER .AND. .NOT. EOF()                                                                                                                                                                                                           
         TPRIC  = TPRIC  + TOT_PRICE                                                                                                                                                                                                                      
         THPRIC = THPRIC + PROC_HL                                                                                                                                                                                                                        
         TPPRIC = TPPRIC + PROC_PAY                                                                                                                                                                                                                       
         CDOCT=DOC_CODE                                                                                                                                                                                                                                   
         IF CDOCT<>SPACE(3)                                                                                                                                                                                                                               
            SET COLO TO BG+/B,W+/N                                                                                                                                                                                                                        
            @ 22,38 CLEAR TO 22,45                                                                                                                                                                                                                        
            SELE 6                                                                                                                                                                                                                                        
            SET EXCLU OFF                                                                                                                                                                                                                                 
            USE &DR&F6 INDE &DR&F6                                                                                                                                                                                                                        
            SEEK INVOI                                                                                                                                                                                                                                    
            IF REC_LOCK()                                                                                                                                                                                                                                 
               DELE                                                                                                                                                                                                                                       
            ENDIF                                                                                                                                                                                                                                         
            UNLOCK                                                                                                                                                                                                                                        
            SELE 4                                                                                                                                                                                                                                        
         ENDIF                                                                                                                                                                                                                                            
         IF REC_LOCK()                                                                                                                                                                                                                                    
            DELE                                                                                                                                                                                                                                          
         ENDIF                                                                                                                                                                                                                                            
         UNLOCK                                                                                                                                                                                                                                           
         SKIP                                                                                                                                                                                                                                             
      ENDDO                                                                                                                                                                                                                                               
      SELE 5                                                                                                                                                                                                                                              
      SET EXCLU OFF                                                                                                                                                                                                                                       
      USE &DR&F5 INDE &DR&F51                                                                                                                                                                                                                             
      SEEK INVOI                                                                                                                                                                                                                                          
      DO WHILE INVOI=INV_NBER .AND. .NOT. EOF()                                                                                                                                                                                                           
         TPRIC  = TPRIC  + PHAR_PRICE                                                                                                                                                                                                                     
         THPRIC = THPRIC + PHAR_HL                                                                                                                                                                                                                        
         TPPRIC = TPPRIC + PHAR_PAY                                                                                                                                                                                                                       
         IF REC_LOCK()                                                                                                                                                                                                                                    
            DELE                                                                                                                                                                                                                                          
         ENDIF                                                                                                                                                                                                                                            
         UNLOCK                                                                                                                                                                                                                                           
         SKIP                                                                                                                                                                                                                                             
      ENDDO                                                                                                                                                                                                                                               
      SELE 1                                                                                                                                                                                                                                              
      SET EXCLU OFF                                                                                                                                                                                                                                       
      USE &DR1&F1 INDE &DR1&F1                                                                                                                                                                                                                            
      SEEK PATCOD                                                                                                                                                                                                                                         
      SELE 2                                                                                                                                                                                                                                              
      SET EXCLU OFF                                                                                                                                                                                                                                       
      USE &DR&F2 INDE &DR&F2                                                                                                                                                                                                                              
      SEEK INVOI                                                                                                                                                                                                                                          
      IF REC_LOCK()                                                                                                                                                                                                                                       
         DELE                                                                                                                                                                                                                                             
      ENDIF                                                                                                                                                                                                                                               
      UNLOCK                                                                                                                                                                                                                                              
      SELE 3                                                                                                                                                                                                                                              
      SET EXCLU OFF                                                                                                                                                                                                                                       
      USE &DR&F3 INDE &DR&F33                                                                                                                                                                                                                             
      SEEK INVOI                                                                                                                                                                                                                                          
      IF REC_LOCK()                                                                                                                                                                                                                                       
         DELE                                                                                                                                                                                                                                             
      ENDIF                                                                                                                                                                                                                                               
      UNLOCK                                                                                                                                                                                                                                              
   CASE PL1=2                                                                                                                                                                                                                                             
        PL15=1                                                                                                                                                                                                                                            
        DO BOX3 WITH 22,20,'MODE OF PAYMENT :',"CASH","CARD","CHEQUE",'W+','G','W+','N',PL15,.F.,.T.                                                                                                                                                      
        DO CASE                                                                                                                                                                                                                                           
        CASE PL15=1                                                                                                                                                                                                                                       
             PAYMODE='CASH'                                                                                                                                                                                                                               
        CASE PL15=2                                                                                                                                                                                                                                       
             PAYMODE='CARD'                                                                                                                                                                                                                               
        OTHER                                                                                                                                                                                                                                             
             PAYMODE='CHEQUE'                                                                                                                                                                                                                             
        ENDCASE                                                                                                                                                                                                                                           
        SELE 3                                                                                                                                                                                                                                            
        SET EXCLU OFF                                                                                                                                                                                                                                     
        USE &DR&F3 INDE &DR&F33                                                                                                                                                                                                                           
        SEEK INVOI                                                                                                                                                                                                                                        
        IF REC_LOCK()                                                                                                                                                                                                                                     
           REPL PAY_MODE WITH PAYMODE                                                                                                                                                                                                                     
           IF TOTAL_CASH=0                                                                                                                                                                                                                                
              REPL TOTAL_CASH WITH TCRE, TOTAL_CRED WITH 0                                                                                                                                                                                                
           ENDIF                                                                                                                                                                                                                                          
        ENDIF                                                                                                                                                                                                                                             
        UNLOCK                                                                                                                                                                                                                                            
   CASE PL1=3                                                                                                                                                                                                                                             
        SELE 3                                                                                                                                                                                                                                            
        SET EXCLU OFF                                                                                                                                                                                                                                     
        USE &DR&F3 INDE &DR&F33                                                                                                                                                                                                                           
        SEEK INVOI                                                                                                                                                                                                                                        
        IF REC_LOCK()                                                                                                                                                                                                                                     
           REPL TOTAL_CASH WITH 0, TOTAL_CRED WITH TCAS                                                                                                                                                                                                   
           REPL PAY_MODE WITH 'CREDIT'                                                                                                                                                                                                                    
        ENDIF                                                                                                                                                                                                                                             
        UNLOCK                                                                                                                                                                                                                                            
   ENDCASE                                                                                                                                                                                                                                                
ENDDO                                                                                                                                                                                                                                                     
                                                                                                                                                                                                                                                          
*Formatted by: Herman T Ver. 7.1  on January 25, 1993.                                                                                                                                                                                                    
